home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / The World of Computer Software.iso / tcsel003.zip / BMSRCH.PAS < prev    next >
Pascal/Delphi Source File  |  1992-10-20  |  4KB  |  103 lines
  1. {$A+,B-,D-,E+,F-,I-,L-,N-,O-,R-,S-,V-}
  2. unit BMSrch;
  3.  
  4. interface
  5.  
  6. type
  7.   Btable = array[0..255] of byte;
  8.  
  9. procedure BMMakeTable(var s; var t : Btable);
  10. function BMSearch(var buff; size : word; Bt: Btable; var st): word;
  11. function BMSearchUC(var buff; size : word; Bt: Btable; var st): word;
  12.  
  13. implementation
  14.  
  15. procedure BMMakeTable(var s; var t : Btable);
  16.   { Makes a Boyer-Moore search table. s = the search string t = the table }
  17.   var
  18.     st  : Btable absolute s;
  19.     slen: byte absolute s;
  20.     x   : byte;
  21.   begin
  22.     FillChar(t,sizeof(t),slen);
  23.     for x := slen downto 1 do
  24.       if (t[st[x]] = slen) then
  25.         t[st[x]] := slen - x
  26.   end;
  27.  
  28. function BMSearch(var buff; size : word; Bt: Btable; var st): word;
  29.   { Not quite a standard Boyer-Moore algorithm search routine }
  30.   { To use:  pass buff as a dereferenced pointer to the buffer}
  31.   {          st is the string being searched for              }
  32.   {          size is the size of the buffer                   }
  33.   { If st is not found, returns $ffff                         }
  34.   var
  35.     buffer : array[0..65519] of byte absolute buff;
  36.     s      : array[0..255] of byte absolute st;
  37.     len    : byte absolute st;
  38.     s1     : string absolute st;
  39.     s2     : string;
  40.     numb,
  41.     x      : word;
  42.     found  : boolean;
  43.   begin
  44.     s2[0] := chr(len);       { sets the length to that of the search string }
  45.     found := false;           
  46.     numb := pred(len);
  47.     while (not found) and (numb < (size - len)) do begin
  48.       if buffer[numb] = ord(s1[len]) then { partial match } begin
  49.         if buffer[numb-pred(len)] = ord(s1[1]) then { less partial! } begin
  50.           move(buffer[numb-pred(len)],s2[1],len);
  51.           found := s1 = s2;                   { if = it is a complete match }
  52.           BMSearch := numb - pred(len);       { will stick unless not found }
  53.         end;
  54.         inc(numb);                 { bump by one char - match is irrelevant }
  55.       end
  56.       else
  57.         inc(numb,Bt[buffer[numb]]);
  58.     end;
  59.     if not found then
  60.       BMSearch := $ffff;
  61.   end;  { BMSearch }
  62.  
  63.  
  64. function BMSearchUC(var buff; size : word; Bt: Btable; var st): word;
  65.   { Not quite a standard Boyer-Moore algorithm search routine }
  66.   { To use:  pass buff as a dereferenced pointer to the buffer}
  67.   {          st is the string being searched for              }
  68.   {          size is the size of the buffer                   }
  69.   { If st is not found, returns $ffff                         }
  70.   var
  71.     buffer : array[0..65519] of byte absolute buff;
  72.     chbuff : array[0..65519] of char absolute buff;
  73.     s      : array[0..255] of byte absolute st;
  74.     len    : byte absolute st;
  75.     s1     : string absolute st;
  76.     s2     : string;
  77.     numb,
  78.     x      : word;
  79.     found  : boolean;
  80.   begin
  81.     s2[0] := chr(len);       { sets the length to that of the search string }
  82.     found := false;           
  83.     numb := pred(len);
  84.     while (not found) and (numb < (size - len)) do begin
  85.       if UpCase(chbuff[numb]) = s1[len] then { partial match } begin
  86.         if UpCase(chbuff[numb-pred(len)]) = s1[1] then { less partial! } begin
  87.           move(buffer[numb-pred(len)],s2[1],len);
  88.           for x := 1 to length(s2) do
  89.             s2[x] := UpCase(s2[x]);
  90.           found := s1 = s2;                   { if = it is a complete match }
  91.           BMSearchUC := numb - pred(len);     { will stick unless not found }
  92.         end;
  93.         inc(numb);                 { bump by one char - match is irrelevant }
  94.       end
  95.       else
  96.         inc(numb,Bt[ord(UpCase(chbuff[numb]))]);
  97.     end;
  98.     if not found then
  99.       BMSearchUC := $ffff;
  100.   end;  { BMSearchUC }
  101.  
  102. end.
  103.